home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 095 / rfix0424.arc / RSB20424.MRG < prev    next >
Text File  |  1988-04-24  |  6KB  |  146 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against RBBSSUB2.BAS to produce RSB20424.BAS
  3. * RBBSSUB2.BAS:  Date 3-25-1988  Size 129045 bytes
  4. * ------------[ Created 04-24-1988 13:56:33 ]------------
  5. * REPLACING old line(s) by new
  6. 270    IF RECYCLE.WAIT > 0 THEN _
  7.           IF TI! > INACTIVE.DELAY! THEN _
  8.              SUBROUTINE.PARAMETER = 8 : _
  9.              EXIT SUB
  10.        CALL FLUSHCOM (X$)
  11.        IF LEN(X$) > O THEN _
  12.           MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$ : _
  13.           RING.DETECTED = (INSTR(MODEM.RESPONSE$,"RING") > 0) : _
  14.           CONNECT.DETECTED = (INSTR(MODEM.RESPONSE$,"ONNECT") > 0) : _
  15.           NO.CALL = (NOT RING.DETECTED) AND (NOT CONNECT.DETECTED)
  16. * ------[ first line different ]------
  17.     CALL GOIDLE                                                      ' TF041703
  18.     WEND
  19.     IF NOT RINGBACK THEN _
  20.        IF CONNECT.DETECTED THEN _
  21.           GOTO 321
  22.     IF REQUIRED.RINGS = 0 THEN _
  23.        CALL DELAYIT (3) : _
  24.        GOTO 321
  25. '
  26. ' *****************************************************************************
  27. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR  *
  28. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --     *
  29. ' * "RING BACK."                                                              *
  30. ' *****************************************************************************
  31. '
  32. * REPLACING old line(s) by new
  33. 323 SUBROUTINE.PARAMETER = -10
  34.     CALL CARRIER
  35.     IF SUBROUTINE.PARAMETER AND _
  36.        TI! < CONNECT.DELAY! THEN _
  37.        GOTO 322
  38.     IF SUBROUTINE.PARAMETER THEN _
  39.        SUBROUTINE.PARAMETER = 4 : _
  40.        EXIT SUB
  41. * ------[ first line different ]------
  42.     CALL DELAYIT (3)                                                 ' TF041704
  43. * REPLACING old line(s) by new
  44. * ------[ first line different ]------
  45. 3732 IF COMMPORT.STACK$ <> "" THEN _                                 ' TF041801
  46.         X$ = LEFT$(COMMPORT.STACK$,1) : _                            ' TF041801
  47.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _ ' TF041801
  48.         GOTO 3738                                                    ' TF041801
  49.      IF NOT EOF(3) THEN _
  50.         GOTO 3736
  51.      CALL FINDTIME (TI!)
  52.      IF TI! > AUTO.LOGOFF! THEN _
  53.         WAIT.EXPIRED = TRUE : _
  54.         EXIT SUB
  55. * REPLACING old line(s) by new
  56. 3737 CALL GETCOM (X$)
  57. * INSERTING new line(s)
  58. 3738 SEND.REMOTE = REMOTE.ECHO                                       ' TF041801
  59. * REPLACING old line(s) by new
  60. 20143 Z$ = B$(ARC.INDEX)
  61.       CALL ALLCAPS (Z$)
  62.       CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)
  63.       IF EXT$ = "" THEN _
  64.          Z$ = Z$ + _
  65.               ".ARC" _
  66.       ELSE IF EXT$ <> "ARC" THEN _
  67.               CALL QTPUT ("Only .ARC files can be viewed",1) : _
  68.               RETURN
  69.       FILE.NAME.HOLD$ = Z$
  70.       FILE.NAME$ = Z$
  71. * ------[ first line different ]------
  72.       CALL BADFILE (PREFIX$,BAD.FILE.NAME.INDEX)                     ' TF042402
  73.       ON BAD.FILE.NAME.INDEX GOTO 20144,20146,20147                  ' TF042402
  74. * REPLACING old line(s) by new
  75. * ------[ first line different ]------
  76. 20144 CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)                  ' TF042402
  77.       ON BAD.FILE.NAME.INDEX GOTO 20145,20146,20147                  ' TF042402
  78. * INSERTING new line(s)
  79. 20145 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + (NOT SYSOP)) ' TF042402
  80.       IF OK THEN _
  81.          GOTO 20148
  82. * REPLACING old line(s) by new
  83. 20296 CALL FLUSHCOM(Y$)                  ' CLEAR THE COMM BUFFER OF GARBAGE
  84.       IF SUBROUTINE.PARAMETER = -1 THEN _
  85.          EXIT SUB
  86.       CALL PUTCOM (ESCAPE$+"OD")         ' SEND "ALERT" STRING         CPC161AI
  87.       IF SUBROUTINE.PARAMETER = -1 THEN _
  88.          EXIT SUB
  89.       IF ABORT = TRUE THEN _
  90.          GOTO 20306
  91.       CALL LPRNT("Sending FILENAME -- ",1)
  92.       CALL LPRNT(RETURN.LINE.FEED$ + CHR$(9),0)
  93.       CALL DELAYIT (1)                   ' WAIT 1 SECOND FOR SETUP
  94. '
  95. '               SEND ONE CHARACTER AT A TIME
  96. '
  97. * ------[ first line different ]------
  98.       CALL BRKFNAME (B$(DWN.INDEX),X$,A$,Y$,TRUE)                    ' TF033104
  99.       A$ = A$ + Y$ + "=X"                                            ' TF033104
  100.       FOR X = 1 TO LEN(A$)
  101.          CALL PUTCOM (MID$(A$,X,1))     ' SEND 1 CHARACTER
  102.          IF SUBROUTINE.PARAMETER = -1 THEN _
  103.             EXIT SUB
  104.          IF ABORT = TRUE THEN _
  105.             GOTO 20306
  106.          CALL LPRNT(MID$(A$,X,1),0)     ' DISPLAY IF NEEDED
  107.          IF TIMER < 86390! THEN _
  108.             DELAY! = TIMER + 10 _
  109.          ELSE DELAY! = TIMER - 86400! + 10 ' SET MAXIMUM TIME TO WAIT FOR REPLY
  110.          WHILE EOF(3)
  111.             IF TIMER > DELAY! THEN _
  112.                GOTO 20300     ' IF NO ECHO, CANCEL FILENAME TRANSFER
  113.          WEND                 ' JUMP OUT IF CHARACTER IS RECEIVED
  114. * REPLACING old line(s) by new
  115. 20720 A$ = "Upload best fits what category (H=help)"
  116.       SUBROUTINE.PARAMETER = 1
  117.       CALL TGET
  118.       IF SUBROUTINE.PARAMETER = -1 THEN _
  119.          B$ = DEFAULT.CATEGORY.CODE$ : _
  120.          GOTO 20722
  121.       IF Q = 0 THEN _
  122.          GOTO 20719
  123.       CALL ALLCAPS (B$(1))
  124. * ------[ first line different ]------
  125.       IF B$(1) = "H" OR _                                            ' TF041901
  126.          B$(1) = "*" OR _                                            ' TF041901
  127.          B$(1) = "?" THEN _                                          ' TF041901
  128.          GOTO 20719
  129.       CALL CHKNARY (B$(1),CATEGORY.NAME$(),NUM.CATEGORIES,FOUND)
  130.       IF FOUND > 0 THEN _
  131.          Y$ = CATEGORY.CODE$(FOUND) : _
  132.          IF LEN(Y$) > 0 AND LEN(Y$) < 4 AND INSTR(Y$,",") = 0 THEN _
  133.             GOTO 20722
  134.       Y$ = ""
  135.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  136.          STREW.TO$ = DIRECTORY.PATH$ + _
  137.                      B$(1) + _
  138.                      "." + _
  139.                      DIRECTORY.EXTENTION$ : _
  140.          CALL FINDIT (STREW.TO$) : _
  141.          IF NOT OK THEN _
  142.             STREW.TO$ = "" _
  143.          ELSE GOTO 20722
  144.       CALL QTPUT ("No such category " + B$(1),1)
  145.       GOTO 20719
  146.